#! /usr/local/bin/perl -sw
# The full monty

use Parse::RecDescent;

local $/;
my $gramms =
q{
	Ctl: Step(s)

	Step:
		'VRSN=' /[0-9]+/
};
my $grammar =  <DATA>;
my $parser = Parse::RecDescent->new($grammar);
#my $parser = new Parse::RecDescent($gramms);
$/ = "\n\n";
my $text = <>;

$parser->Ctl($text) or die "bad C code";

__DATA__

	Ctl:
		Ctlversion 
		isApplication(?)
		hasISNs(?) 
		right_description(s?)
		help_description(s?) 
		type_description(s?)


	Ctlversion:
		'VRSN='
		/[0-9]+/
		{ print "Version = $item[2] \n"; 1;   }

	isApplication:
    'APPLICATION=' /Y|N/  

    hasISNs:
			'ISN=' /Y|N/

	right_description:
	'RGHT={'
	(rightname)(?)
	(rightkey)(?)
	'PBLC=' /Y|N/
	'}'

	help_description:
	'HLP={'
	(helpdesc)(?)
	(helpcolor)(?)
	helpform
	'}'


rightname:
 'NAME="' /[^"]+/ '",'

rightkey:
 'KEY="'  /[^"]+/  '",'

helpdesc:
 'DESC="' /[^"]+/ '",'

helpcolor:
 'COLOR=' /\\d+/ ','


helpform:			
	'FRM={'
	'OPN=' /[^"]/ ','
	'MOD=' /[^"]/ ','
	'SYSMNU=' /Y|N/ ','
	(helpCRT)(?)
	(helpQRY)(?)
	(helpMDFY)(?)
	(helpDEL)(?)
	(helpX)(?)	
	(helpY)(?)	
	'DX=' /[0-9]+/ ','
	'DY=' /[0-9]+/ ','
	(helpCOLOR)(?)
	(helpFRM)(?)
	 '},'
	'WIN={'
	'DX=' /[0-9]+/ ','
	'DY=' /[0-9]+/ ','
	(helpWINCOLOR)(?)
	'},'
	(helpBLOCK)(?)
			
helpCRT:
 'CRT=' /[0-9]+/ ','

helpQRY:
 'QRY=' /[0-9]+/ ','

helpMDFY:
 'MDFY=' /[0-9]+/ ','

helpDEL:
 'DEL=' /[0-9]+/ ','

helpX:
 'X=' /[0-9]+/ ','

helpY:
 'Y=' /[0-9]+/ ','

helpCOLOR:
 'COLOR=' /[0-9]+/ ','

helpFRM:
 'FRM=' /[0-9]+/ 

helpWINCOLOR:
 'COLOR=' /[0-9]+/ 

helpBLOCK:
 'BLOCK={'
	(helpBLOCKX)(?)
	(helpBLOCKY)(?)
	(helpBLOCKCOLOR)(?)
	 'TXT="' /[^"]+/ '"'
	'},'

helpBLOCKX:
 'X=' /[0-9]+/ ','

helpBLOCKY:
 'Y=' /[0-9]+/ ','

helpBLOCKCOLOR:
 'COLOR=' /[0-9]+/ ','


type_description:

	'TYP={'
   (typeDESC)(?)
	(typePIC)(?)
	(typeRNG)(?)
	'ATTR=' /[^"]/ ','
	'RSRCE={'
	(typeHLP)(?)
	(typeTXT)(?)
	(typePRG)(?)
	'MOD=' /[^"]/ ','
	'CTRL=' /[^"]/ ','
	(typeOPN)(?)
	(typeQRY)(?)
	(typeMDFY)(?)
	(typeDEL)(?)
	(typePB_ACT)(?)
	(typeCTRL_CLS)(?)
	'CTRL_STP="' /[^"]+/ '",'
	'NUL_ALW=' /Y|N/
	(typeNUL_VAL)(?)
	(typeNUL_DSP)(?)
	(typeDBNAME)(?)
	'}'
	'}'


typeDESC: 'DESC="' /[^"]+/ '",'
	{ print "type desc=$item[2]\n"; 1; }
	
typePIC: 'PIC="' /[^"]+/ '",'

typeRNG: 'RNG="' /[^"]+/ '",'

typeHLP: 'HLP=' /\\d+/ ','

typeTXT: 'TXT=' /\\d+/ ','

typePRG: 'PRG=' /\\d+/ ','

typeOPN: 'OPN=' /\\d+/ ','

typeQRY: 'QRY=' /\\d+/ ','

typeMDFY: 'MDFY=' /\\d+/ ','

typeDEL: 'DEL=' /\\d+/ ','

typePB_ACT: 'PB_ACT=' /\\d+/ ','

typeCTRL_CLS: 'CTRL_CLS=' /\\d+/ ','

typeNUL_VAL: ',NUL_VAL="' /[^"]+/ 'null value>"'

typeNUL_DSP: ',NUL_DSP="' /[^"]+/ 'null string>"'

typeDBNAME: ',DBNAME="' /[^"]+/ '"'
	{ print "dbname=$item[2]\n"; 1; }